home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / TCOLOR~1.FRM < prev    next >
Text File  |  1997-06-14  |  3KB  |  99 lines
  1. VERSION 5.00
  2. Object = "{35DFF35F-DEB3-11D0-8C50-00C04FC29CEC}#1.0#0"; "ColorPicker.ocx"
  3. Begin VB.Form FTestColorPick 
  4.    AutoRedraw      =   -1  'True
  5.    Caption         =   "Test Color Pickers"
  6.    ClientHeight    =   3705
  7.    ClientLeft      =   1185
  8.    ClientTop       =   2925
  9.    ClientWidth     =   5355
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    Icon            =   "tcolorpick.frx":0000
  20.    LinkTopic       =   "Form1"
  21.    PaletteMode     =   1  'UseZOrder
  22.    ScaleHeight     =   3705
  23.    ScaleWidth      =   5355
  24.    WhatsThisHelp   =   -1  'True
  25.    Begin ColorPicker.XColorPicker pick 
  26.       Height          =   1284
  27.       Left            =   216
  28.       TabIndex        =   2
  29.       Top             =   120
  30.       Width           =   1692
  31.       _ExtentX        =   3731
  32.       _ExtentY        =   2831
  33.    End
  34.    Begin VB.CheckBox chkWideControl 
  35.       Caption         =   "Wide Control"
  36.       Height          =   372
  37.       Left            =   216
  38.       TabIndex        =   1
  39.       Top             =   2250
  40.       UseMaskColor    =   -1  'True
  41.       Width           =   1572
  42.    End
  43.    Begin VB.CheckBox chkWideForm 
  44.       Caption         =   "Wide Form"
  45.       Height          =   372
  46.       Left            =   216
  47.       TabIndex        =   0
  48.       Top             =   1905
  49.       UseMaskColor    =   -1  'True
  50.       Width           =   1695
  51.    End
  52.    Begin VB.Label lbl 
  53.       Caption         =   "Right-click form to display FColorPicker"
  54.       Height          =   255
  55.       Left            =   216
  56.       TabIndex        =   3
  57.       Top             =   2880
  58.       Width           =   3495
  59.    End
  60. End
  61. Attribute VB_Name = "FTestColorPick"
  62. Attribute VB_GlobalNameSpace = False
  63. Attribute VB_Creatable = False
  64. Attribute VB_PredeclaredId = True
  65. Attribute VB_Exposed = False
  66. Option Explicit
  67.  
  68. Private Sub chkWideControl_Click()
  69.     pick.Wide = -chkWideControl
  70. End Sub
  71.  
  72. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
  73.                          X As Single, Y As Single)
  74.     If Button = 2 Then
  75.         Dim getclr As New CColorPicker
  76.         Static clrLast As Long
  77.         ' Load last color used
  78.         If clrLast <> 0& Then getclr.Color = clrLast
  79.         ' Load dialog at given position and shape
  80.         getclr.Load Left + X, Top + Y, -chkWideForm
  81.         ' Save chosen color for next time
  82.         clrLast = getclr.Color
  83.         ' Change color of form and check boxes
  84.         AllColors clrLast
  85.     End If
  86. End Sub
  87.  
  88. Private Sub pick_Picked(Color As stdole.OLE_COLOR)
  89.     AllColors Color
  90. End Sub
  91.  
  92. Sub AllColors(ByVal clr As Long)
  93.     BackColor = clr
  94.     chkWideForm.BackColor = clr
  95.     chkWideControl.BackColor = clr
  96.     chkWideForm.MaskColor = clr
  97.     chkWideControl.MaskColor = clr
  98. End Sub
  99.